home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / mail / mh / contrib / audit / refileto < prev    next >
Encoding:
Text File  |  1992-11-19  |  3.2 KB  |  141 lines
  1. #!/usr/bin/perl
  2.  
  3. $program = $0;
  4. $program =~ s|.*/||;
  5. $| = 1;
  6.  
  7. unshift(@INC, $ENV{'DELIVERPATH'});
  8. require 'audit.pl' || die "$program: cannot include audit.pl: $@";
  9. require 'mh.pl' || die "$program: cannot include mh.pl: $@";
  10.  
  11. @SW = (
  12.     '-debug',
  13.     '-draft',
  14.         '-file file',
  15.     '-help',
  16.     '-link',
  17.     '-log +folder',        # defaults to +log
  18.     '-nolink',
  19.     '-nopreserve',
  20.     '-preserve',
  21.       '-rmmproc program',
  22.     '-src +folder',        # defaults to current folder
  23.     '-verbose',
  24.       );
  25.  
  26.  
  27. &mh_profile();
  28. &mh_parse();
  29.  
  30.  
  31. defined($SW{'help'}) && do {
  32.     print "syntax: $program [msgs] [switches]\n";
  33.     &print_switches();
  34.     exit;
  35. };
  36.  
  37.  
  38. @args = (defined(@MSGS) ? @MSGS : @ARGV);
  39.  
  40.  
  41. $logdir = $SW{'log'} || $MH{'logdir'} || "+log";
  42. ($logdir = '+' . $logdir) if ($logdir !~ /\+/);
  43. $folder = `mhpath cur`; chop $folder; $folder =~ s|/\d+$||;
  44. $folder = $SW{'src'} if defined($SW{'src'});
  45. ($folder = '+' . $folder) if ($folder !~ /\+/);
  46.  
  47.  
  48. $SW{'file'} = "$MH{'path'}/draft" if defined($SW{'draft'});
  49. if (defined($SW{'file'})) {
  50.     @paths = ($file);
  51. } else {
  52.     @paths = `mhpath $folder @args`; chop @paths;
  53. };
  54.  
  55.  
  56. @refileargs = ( );
  57. for ('link', 'nolink', 'preserve', 'nopreserve') {
  58.     push(@refileargs, "-$_") if defined($SW{$_});
  59. };
  60. push(@refileargs, "-rmmproc", $SW{'rmmproc'}) if defined($SW{'rmmproc'});
  61.  
  62.  
  63. foreach $msg (@paths) {
  64.     open(MESSAGE, "< $msg") || next;
  65.  
  66.     &local_parse_message(MESSAGE);
  67.  
  68.     # -----
  69.     # if -from was specified use the From line; if -to is specified use
  70.     # the To line. 
  71.     #
  72.     $header = $headers{'from'} if ($program eq "refilefrom");
  73.     $header = $headers{'to'} if ($program eq "refileto");
  74.     $header = $header . ',' . $headers{'cc'} if 
  75.     (($program eq "refileto") && defined($headers{'cc'}));
  76.  
  77.     @nfolders = ( ); 
  78.     foreach $addr (split(',', $header)) {
  79.        ($friendly, $address, $name, $org) = &parse_email_address($addr);
  80.        $org = "local" if ($org eq "unknown");
  81.        push(@nfolders, "$logdir/$org/$name");
  82.     };
  83.  
  84.     @mfolders = ( );
  85.     foreach $folder (@nfolders) {
  86.        $fpath = `mhpath $folder`; chop $fpath;
  87.        if (-d $fpath || ! &make_mhpath($fpath)) {
  88.            push(@mfolders, $folder);
  89.        } else {
  90.        warn "cannot make directory $fpath: $!\n";
  91.        };
  92.     };
  93.  
  94.     print "refile @refileargs -file $msg @mfolders\n" if 
  95.     (@mfolders && defined($SW{'verbose'}));
  96.     system "refile -file $msg @mfolders" if 
  97.     (@mfolders && !defined($SW{'debug'}));
  98.  
  99.     close(MESSAGE);
  100. };
  101.  
  102.  
  103. # =====
  104. # Subroutine local_parse_message
  105. #    A simplified version of parse_message that does
  106. #    not care about the body of the message
  107. #
  108. sub local_parse_message {
  109.     local(*INFILE) = @_;
  110.     local($header, $body, $mheader);
  111.  
  112.     $/ = '';        # read input in paragraph mode
  113.     %headers = ( );
  114.     @received = ( );
  115.  
  116.     $header = <INFILE>;
  117.     $/ = "\n";        
  118.     $* = 0;
  119.  
  120.     # -----
  121.     # fill out the headers associative array with fields from the mail
  122.     # header.
  123.     #
  124.     $_ = $header;
  125.     s/\n\s+//g;
  126.     @lines = split('\n');
  127.     for ( @lines ) {
  128.     /^(\w*):\s*(.*)/ && do {
  129.         $mheader = $1;
  130.         $mheader =~ tr/A-Z/a-z/;
  131.         if (($mheader eq "cc" || $mheader eq "to") && $headers{$mheader}) {
  132.         $headers{$mheader} .= ", $2";
  133.         } else {
  134.         $headers{$mheader} = $2;
  135.         };
  136.     };
  137.     }
  138.  
  139.     return;
  140. }
  141.